home *** CD-ROM | disk | FTP | other *** search
/ Aminet 8 / Aminet 8 (1995)(GTI - Schatztruhe)[!][Oct 1995].iso / Aminet / util / batch / chequals.lha / CheckQuals / Source / CheckQualifiers.mod < prev   
Text File  |  1995-04-16  |  6KB  |  212 lines
  1. (******************************************************************************
  2.  
  3. :Remark.            Format: ein TAB in jeder 3. Spalte: ..tab..tab..tab..
  4.  
  5.  
  6. :Program.        CheckQualifiers
  7.  
  8. :Contents.        checks for given qualifiers and returns warn if any of the given
  9. :Contents.        qualifiers is pressed, ok else
  10.  
  11. :Bugs.            "Shit happens." (Murphy)
  12.  
  13.  
  14. :Copyright.        PD
  15.  
  16. :Author.            Thomas Ansorge
  17.  
  18. :Address.        Dinkelackerring 55, 67435 Neustadt, Deutschland, Europa
  19.  
  20.  
  21. :Language.        Modula-2
  22.  
  23. :Translator.    M2Amiga V4.3 (deutsch)
  24.  
  25.  
  26. :History.        1.0 as of 24-Dec-1994:
  27. :History.            - first working version
  28.  
  29. :History.        1.1 as of 02-Jan-1995
  30. :History.            - checks for exactly the given set of qualifiers, not subset
  31.  
  32. :History.        1.2 as of 04-Jan-1995
  33. :History.            - empty set allowed
  34. :History.            - returnVal = fail if an error occurs
  35. :History.            - "unknown args" message if ReadArgs () fails
  36.  
  37. :History.        1.3 as of 06-Jan-1995
  38. :History.            - returns
  39. :History.                0: none of the given qualifiers are pressed
  40. :History.                1: at least one (but not all) of the given qualifiers are pressed
  41. :History.                2: all of the given qualifiers are pressed and some more
  42. :History.                3: exactly the given qualifiers are pressed
  43.  
  44. :History.        1.4 as of 15-Jan-1995
  45. :History.            - PrintFault (IoErr (), NIL) instead of WriteString (...) after failure of ReadArgs ()
  46.  
  47.  
  48. ******************************************************************************)
  49.  
  50.  
  51. MODULE CheckQualifiers;
  52.  
  53. FROM Arts IMPORT returnVal;
  54.  
  55. FROM DosD IMPORT fail, FileHandlePtr, RDArgsPtr;
  56.  
  57. FROM DosL IMPORT dosVersion, FreeArgs, IoErr, Output, PrintFault, ReadArgs, Write;
  58.  
  59. FROM ExecD IMPORT IOStdReq, IOStdReqPtr, MsgPortPtr;
  60.  
  61. FROM ExecL IMPORT CloseDevice, CreateIORequest, CreateMsgPort, DeleteIORequest, DeleteMsgPort, execVersion, OpenDevice;
  62.  
  63. (*$ IF M68881 *)
  64. IMPORT FPUExc;
  65. (*$ ENDIF *)
  66.  
  67. FROM Input IMPORT inputName, PeekQualifier;
  68.  
  69. FROM InputEvent IMPORT Qualifiers, QualifierSet;
  70.  
  71. FROM SYSTEM IMPORT ADR, CAST, LONGSET;
  72.  
  73. (* ------------------------------------------------------------------------- *)
  74.  
  75. CONST
  76.     ver_str = "$VER: CheckQualifiers 1.4/";
  77.     date_str = " (15.01.95)";
  78.  
  79.     (*$ IF M68881 OR M68040 *)
  80.         ver_ptr = ADR (ver_str + "68020+FPU" + date_str);
  81.     (*$ ELSIF M68020 *)
  82.         ver_ptr = ADR (ver_str + "68020" + date_str);
  83.     (*$ ELSIF M68010 *)
  84.         ver_ptr = ADR (ver_str + "68010" + date_str);
  85.     (*$ ELSE *)
  86.         ver_ptr = ADR (ver_str + "68000" + date_str);
  87.     (*$ ENDIF *)
  88.  
  89.     min_dos_version = 36;
  90.     min_exec_version = 36;
  91.  
  92.     (* ACHTUNG! template, Quals und quals_array müssen übereinstimmen! *)
  93.     template = "LSHIFT/S,RSHIFT/S,CAPSLOCK/S,CONTROL/S,LALT/S,RALT/S,LCOMMAND/S,RCOMMAND/S,MIDBUTTON/S,RIGHTBUTTON/S,LEFTBUTTON/S";
  94.  
  95. TYPE
  96.     (* ACHTUNG! template, Quals und quals_array müssen übereinstimmen! *)
  97.     Quals = (q_lshift, q_rshift, q_capsLock, q_control, q_lalt, q_ralt, q_lcommand, q_rcommand, q_midbutton, q_rightbutton, q_leftbutton);
  98.  
  99.     QualsArray = ARRAY Quals OF Qualifiers;
  100.     QualFlagArray = ARRAY Quals OF LONGINT;
  101.  
  102. CONST
  103.     (* ACHTUNG! template, Quals und quals_array müssen übereinstimmen! *)
  104.     quals_array = QualsArray {lShift, rShift, capsLock, control, lAlt, rAlt, lCommand, rCommand, midButton, rightButton, leftButton};
  105.  
  106. VAR
  107.     (* Pointers *)
  108.     msg_port_ptr: MsgPortPtr;
  109.     rd_args_ptr: RDArgsPtr;
  110.     req_ptr: IOStdReqPtr;
  111.  
  112.     (* other 32bit stuff *)
  113.     given_quals: QualFlagArray;
  114.  
  115.     (* other stuff *)
  116.     check_quals: QualifierSet;
  117.     i: Quals;
  118.     quals: QualifierSet;
  119.  
  120. (* ------------------------------------------------------------------------- *)
  121.  
  122. PROCEDURE WriteString (str: ARRAY OF CHAR);
  123.  
  124.     VAR
  125.         written: LONGINT;
  126.  
  127.     BEGIN (* Prozedur WriteString *)
  128.         IF Output () # NIL THEN
  129.             written := Write (Output (), ADR (str), -1);
  130.         END; (* IF Output () # NIL *)
  131.     END WriteString; (* Prozedur *)
  132.  
  133. (* ------------------------------------------------------------------------- *)
  134.  
  135. BEGIN
  136.     IF (execVersion >= min_exec_version) AND (dosVersion >= min_dos_version) THEN
  137.         rd_args_ptr := ReadArgs (ADR (template), ADR (given_quals), NIL);
  138.  
  139.         IF rd_args_ptr # NIL THEN
  140.             check_quals := QualifierSet {};
  141.  
  142.             FOR i := MIN (Quals) TO MAX (Quals) DO
  143.                 IF given_quals [i] # 0 THEN
  144.                     INCL (check_quals, quals_array [i]);
  145.                 END; (* IF given_quals [i] # 0 *)
  146.             END; (* FOR i := MIN (Quals) TO MAX (Quals) DO *)
  147.  
  148.             msg_port_ptr := CreateMsgPort ();
  149.  
  150.             IF msg_port_ptr # NIL THEN
  151.                 req_ptr := CreateIORequest (msg_port_ptr, SIZE (req_ptr^));
  152.  
  153.                 IF req_ptr # NIL THEN
  154.                     OpenDevice (ADR (inputName), 0, req_ptr, LONGSET {});
  155.  
  156.                     IF req_ptr^.error = 0 THEN
  157.                         quals := CAST (QualifierSet, PeekQualifier (req_ptr^.device));
  158.  
  159.                         IF quals * check_quals # QualifierSet {} THEN
  160.                             (* at least one of the given qualifiers has been pressed *)
  161.                             IF quals * check_quals = check_quals THEN
  162.                                 (* check_quals or more are pressed *)
  163.                                 IF quals = check_quals THEN
  164.                                     (* exactly check_quals are pressed *)
  165.                                     returnVal := 3;
  166.  
  167.                                 ELSE (* IF quals = check_quals *)
  168.                                     returnVal := 2;
  169.                                 END; (* IF quals = check_quals ELSE *)
  170.  
  171.                             ELSE (* IF quals * check_quals = check_quals *)
  172.                                 returnVal := 1;
  173.                             END; (* IF quals * check_quals = check_quals ELSE *)
  174.  
  175.                         ELSE (* IF quals * check_quals # QualifierSet {} *)
  176.                             returnVal := 0;
  177.                         END; (* IF quals * check_quals # QualifierSet {} ELSE *)
  178.  
  179.                         CloseDevice (req_ptr);
  180.  
  181.                     ELSE (* IF req_ptr^.error = 0 *)
  182.                         WriteString ("Sorry, could not open the input.device!\n");
  183.                         returnVal := fail;
  184.                     END; (* IF req_ptr^.error = 0 ELSE *)
  185.  
  186.                     DeleteIORequest (req_ptr);
  187.  
  188.                 ELSE (* IF req_ptr # NIL *)
  189.                     WriteString ("Sorry, could not create IOStdReq!\n");
  190.                     returnVal := fail;
  191.                 END; (* IF req_ptr # NIL ELSE *)
  192.  
  193.                 DeleteMsgPort (msg_port_ptr);
  194.  
  195.             ELSE (* IF msg_port_ptr # NIL *)
  196.                 WriteString ("Sorry, could not open msg port!\n");
  197.                 returnVal := fail;
  198.             END; (* IF msg_port_ptr # NIL ELSE *)
  199.  
  200.             FreeArgs (rd_args_ptr);
  201.  
  202.         ELSE (* IF rd_args_ptr # NIL *)
  203.             IF PrintFault (IoErr (), NIL) THEN END;
  204.             returnVal := fail;
  205.         END; (* IF rd_args_ptr # NIL ELSE *)
  206.  
  207.     ELSE (* IF (execVersion >= min_exec_version ... *)
  208.         WriteString ("Sorry, your OS is too old (2.0 recommended)!\n");
  209.         returnVal := fail;
  210.     END; (* IF execVersion >= min_exec_version ... ELSE *)
  211. END CheckQualifiers. (* Programm *)
  212.